home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 9 / Night Owl CD-ROM (NOPV9) (Night Owl Publisher) (1993).ISO / 010a / cliptree.zip / GPATH.PRG < prev    next >
Text File  |  1993-02-08  |  11KB  |  288 lines
  1. /*┌──────────────────────────────────────────────────────────────────────┐
  2.  ▌│                                                                      │
  3.  ▌│ Program Name: GPATH.PRG         Copyright: ************************* │
  4.  ▌│ Date Created: 02/06/93           Language: Clipper 5.0               │
  5.  ▌│ Time Created: 12:09:30             Author: Howard G. Smith           │
  6.  ▌│ c:/brief/clipper.src              Altered: Kevin S. Gallagher        │
  7.  ▌│                                                                      │
  8.  ▌│ * This function was downloaded from GRUMPFISH BBS                    │
  9.  ▌│ * Tweaked main function to include "hidden directories"              │
  10.  ▌│ * Cleaned up coding for sake of reading code.                        │
  11.  ▌│ * Revamped test function, the original didn't do much!               │
  12.  ▌│ * Added header file                                                  │
  13.  ▌│ * Added static variables for achoice shell                           │
  14.  ▌│ * Added option to optionally change to the selected dir in achoice() │
  15.  ▌│ * Added option to change to another drive                            │
  16.  ▌│ * Gave the program the look/feel of Norton Change Directory v4.5     │
  17.  ▌│ * Alternate alert box function by: Stephen L. Woolstenhulme          │
  18.  ▌│ * Tweaked Steve's box to place a shadow around the alert box         │
  19.  ▌│ * Revisions made 02/08/93 to work with my file finder - KSG          │
  20.  ▌└──────────────────────────────────────────────────────────────────────┘
  21.  ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀           */
  22.  
  23. #include "include1.h"
  24. #undef K_SPACE
  25. #define K_SPACE 32
  26.  
  27. STATIC aBar_   :={},   /* these variables are mostly for the */     ;
  28.        nTotEle :=0,    /* scrollbar and UDF for ACHOICE      */     ;
  29.        sEle    :=0,    /* and if so desired can be removed   */     ;
  30.        nChoice :=0,    /* without much work!                 */     ;
  31.        aText_  :={},                                                ;
  32.        nErrCode:= 0    /* error code for disk array udfs     */
  33.  
  34.  
  35. function main( Parm1, Parm2 )
  36.     LOCAL cDefErr:=ERRORBLOCK(), DISK_ARR:= curdrive() + "DISK.DAT"
  37.     local oldcolor:= setcolor("W+/B,B+/W"), cStr, xCMD := "CD ", i:=1, aDirs_
  38.     local nTr :=3, nTc :=8, nBr :=20, nBc :=72, lWrite:= .F., lRead := .F.
  39.     /*
  40.     * bypass clippers error saver
  41.     */
  42.     ERRORBLOCK( {|e| ERRORSAVER(e, cDefErr, "VTREE", "ERROR.TXT")})
  43.     IF VALTYPE(Parm1) == "C"
  44.         Parm1 := upper(Parm1)
  45.         DO CASE
  46.             CASE "/?" $ Parm1
  47.                 CMDHELP()
  48.             CASE "/W" $ upper(Parm1)
  49.                 lWrite:=.T.
  50.             CASE "/R" $ upper(Parm1)
  51.                 lRead := .T.
  52.             OTHERWISE
  53.                 //
  54.         ENDCASE
  55.     ENDIF
  56.     IF !EMPTY(Parm1)
  57.         DO CASE
  58.             CASE AT(":",Parm1)==2 .AND. AT("/",Parm1)==3 .AND. LEN(Parm1)==4
  59.                 cStr  := SUBS(Parm1,1,2)+"\"
  60.                 lRead := IF(RIGHT(Parm1,1) == "R",.T.,.F.)
  61.                 lWrite:= IF(RIGHT(Parm1,1) == "W",.T.,.F.)
  62.             CASE "/" $ Parm1 .AND. AT(":",Parm1) == 0
  63.                 cStr := curdrive()
  64.             CASE AT(":",Parm1) == 2 .AND. LEN(Parm1) == 2
  65.                 cStr := SUBS(Parm1,1,2)+"\"
  66.                 IF cStr != curdrive() 
  67.                     DISK_ARR  := SUBS(cStr,1,1)+SUBS(DISK_ARR,2)
  68.                     IF VALTYPE(Parm2) == "C"
  69.                         parm2 := upper(parm2)
  70.                         lRead := IF("/R" $ Parm2,.T.,.F.)
  71.                         lwrite:= IF("/W" $ Parm2,.T.,.F.)
  72.                     ENDIF
  73.                 ENDIF
  74.             OTHERWISE
  75.                 cStr := curdrive()
  76.         ENDCASE
  77.     ELSE
  78.         cStr := curdrive()
  79.     ENDIF
  80.  
  81.     if !DrvReady( SUBS( cStr,1,1) )
  82.         ALERT("ERROR READING "+cStr,{" QUIT "})
  83.         QUIT
  84.     endif
  85.  
  86.     Panel( .F. )
  87.     SETCURSOR(0)
  88.     
  89.     WideBox(nTr,nTc,nBr,nBc,"Directory Tree")
  90.     @ 4,11 say "Current Directory: "+cStr
  91.     @ 5,11 say replicate('─',59)
  92.     IF FILE( DISK_ARR ) .AND. !lRead
  93.         aDirs_:=FT_RESTARR(DISK_ARR,@nErrCode)
  94.         IF nErrCode <> 0
  95.             alert("ERROR")
  96.         ENDIF
  97.     ELSE
  98.         Msg("Scanning"," Disk for directories..;   ",MsgColor)
  99.         aDirs_:=grafpath( cStr,{ | s | CENTER( MIDRow(), STR(i++,4) ) } )
  100.         IF lRead
  101.             IF(FILE(DISK_ARR),FERASE(DISK_ARR),NIL)  // erase old file
  102.             FT_SAVEARR(aDirs_,DISK_ARR,@nErrCode)    // create disk array
  103.         ENDIF
  104.     ENDIF
  105.  
  106.     IF( LEN(aDirs_[1]) < 10, scroll(nTr+3,nTc+3,nBr-2,nBc-1),NIL)
  107.     nTotEle:= LEN(aDirs_[DIR_NAM])
  108.     aBar_  := ScrollBarDisplay( { nTr+1, nBc, nBr-1, nBc, "w+/b", 1 } )
  109.     aText_ := ACLONE(aDirs_)
  110.     @0,0 say PADR(" [ENTER]= file listing [F10]= exit",80) color "w+/rb"
  111.     keyboard chr(255)
  112.     ACHOICE( nTr+3,nTc+3,nBr-1,nBc-3 ,aDirs_[1],,"ashell",sEle)
  113.     cStr   := IF(nChoice # 0, aDirs_[DIR_PATH,nChoice],NIL)
  114.     IF VALTYPE(cStr) == "C" .AND. LEN(cStr) > 3
  115.         cStr := SUBS( cStr, 1, RAT("\", cStr)-1 )
  116.     ENDIF
  117.     /*
  118.     * Function extracted from NANFOR.LIB - public domain library
  119.     * See SAVEARR.PRG for usage and sample function....
  120.     */
  121.     IF lWrite
  122.         IF(FILE(DISK_ARR),FERASE(DISK_ARR),NIL)  // erase old file
  123.         FT_SAVEARR(aDirs_,DISK_ARR,@nErrCode)    // create disk array
  124.     ENDIF
  125.  
  126.     IF pickone([ Change to ]+cStr+" ",{[ Yes ],[ No ]},12,2,[w+/rb])==1
  127.         IF upper(SUBS(cStr,1,3)) != curdrive()
  128.             RUN ( SUBS(cStr,1,2) )
  129.         endif
  130.         RUN  (xCMD+cStr)
  131.     ENDIF
  132.     setcolor(oldcolor)
  133.     scroll()
  134.     SETCURSOR(1)
  135. return nil
  136.  
  137. function grafpath(cCurpath, bMessg)
  138.     local adirlst := {}, aSubdirlst := {}, aRetArr := {{},{}}, aArr_:={}, x
  139.     local lLastNam, cnextpath, retval
  140.  
  141.     cCurpath := IF(valtype(cCurpath) = "U", "\", Upper( cCurpath))
  142.     /*
  143.     * get directory information (names only)
  144.     */
  145.     AEVAL(DIRECTORY(cCurpath+"*.*","DSH"),{ |a| IF( EVAL(OkBLOCK[1],a) .AND.;
  146.       !EVAL( OkBLOCK[2], a ), AADD( aDirLst, T_BRANCH + a[1]),) }              ;
  147.     )
  148.     /*
  149.     * Build array of character pointers to each directory, and a graphic tree
  150.     * of the entire disk. You may need to increase the STACK size for many
  151.     * directories on a large disk.
  152.     */
  153.     if !empty(aDirlst)
  154.         asort(aDirlst)
  155.         aDirlst[len(aDirlst)] = L_BRANCH + substr(aDirlst[len(aDirlst)],3)
  156.     endif
  157.     /*
  158.     * used to show our progress while filling arrays
  159.     */
  160.     EVAL(bMessg,cCurpath)
  161.  
  162.     AEVAL(aDirlst, {|cDir| cnextpath := cCurpath + SUBS(cDir, 3 ) + "\",    ;
  163.     AADD( aRetarr[DIR_NAM], cDir ),                                            ;
  164.     AADD( aRetarr[DIR_PATH], cNextpath),                                    ;
  165.     lLastnam  := (cDir == aDirlst[LEN(aDirlst)]),                           ;
  166.     aSubDirLst:= GRAFPATH(cNextpath,bMessg),                                ;
  167.     AEVAL(aSubdirlst[DIR_NAM], {|cDirNam|                                     ;
  168.     AADD(aretarr[DIR_NAM], IF(lLastnam,NO_BRANCH,I_BRANCH)+ cDirNam)}),     ;
  169.     AEVAL(aSubdirlst[DIR_PATH], {|cNewDirPath|                                ;
  170.     AADD(aretarr[DIR_PATH], cNewDirPath) } ) }                              )
  171.  
  172.     if SUBS(cCurpath,2) == ":\" .OR. cCurpath == "\"
  173.         AADD( aretarr[DIR_NAM] ,   )
  174.         AADD( aretarr[DIR_PATH],   )
  175.         AINS( aretarr[DIR_NAM] , 1 )
  176.         AINS( aretarr[DIR_PATH], 1 )
  177.         aretarr[DIR_NAM,1] := aretarr[DIR_PATH,1] := cCurpath
  178.         retval = aRetArr
  179.     else
  180.         retval = aRetArr
  181.     endif
  182. return(retVal)
  183.  
  184. FUNCTION ashell( status, nElem, nRight )
  185.     local RetVal := 2, nKey := lastkey()
  186.     /*
  187.     * Pressing [ENTER] or [SPACEBAR] --> show files in diretory
  188.     * Pressing [F10]                 --> exits achoice
  189.     */
  190.  
  191.     DO CASE
  192.         CASE status == 0 .OR. nKey == 255
  193.             ScrollBarUpdate(aBar_,nElem,nTotEle,.T.)
  194.         CASE status == 1
  195.             keyboard CHR(K_CTRL_PGDN)
  196.             RetVal  := 2
  197.         CASE status == 2
  198.             keyboard CHR(K_CTRL_PGUP)
  199.             RetVal  := 2
  200.         CASE nKey   == K_F10
  201.             nChoice := nElem
  202.             RetVal  := 0
  203.         CASE nKey   == K_HOME
  204.             keyboard CHR(K_CTRL_PGUP)
  205.         CASE nKey   == K_END
  206.             keyboard CHR(K_CTRL_PGDN)
  207.         CASE nKey   == K_ESC
  208.             alert("PRESS F10 TO EXIT")
  209.             RetVal  := 2
  210.         CASE nKey   == K_LEFT
  211.             keyboard CHR(K_DOWN)
  212.         CASE nKey   == K_RIGHT
  213.             keyboard CHR(K_UP)
  214.         CASE nKey   == K_SPACE .OR. nKey == K_ENTER
  215.             ShowFiles(aText_[2,nElem])
  216.             RetVal  := 2
  217.     ENDCASE
  218. return RetVal
  219. /*
  220. * Called from the achoice shell,shows all files in selected directory
  221. */
  222. function ShowFiles( CurrDir )
  223.     local a:=directory(CurrDir+"*.*"), b:={},oldscrn
  224.     local nTr :=5,nTc :=30,nBr :=19,nBc :=50, oldcolor:=setcolor(MsgColor)
  225.     aeval(a, { |x| aadd(b,x[1]) } )
  226.     b:=asort(b)
  227.     if len(b) <> 0
  228.         oldscrn:=savescreen(nTr,nTc,nBr+1,nBc+2)
  229.         BoxShad(nTr,nTc,nBr,nBc,,5)
  230.         achoice(nTr+1,nTc+1,nBr-1,nBc-1,b)
  231.         restscreen(nTr,nTc,nBr+1,nBc+2,oldscrn)
  232.     else
  233.         alert("Zero files")
  234.     endif
  235.     setcolor(oldcolor)
  236. return nil
  237.  
  238. Function WideBox(nTr,nTc,nBr,nBc,cMsg)
  239.     BoxShad(nTr,nTc,nBr,nBc,,7)
  240.     CENTER(nTr,' '+cMsg+' ')
  241. Return (NIL)
  242.  
  243. Function Msg(Title,cText,cColor)
  244.     local aText := aDelimit(cText)
  245.     local i := MIDRow() - (Len(aText)/2)
  246.     local oldColor := setcolor( IF( cColor <> NIL, cColor, setcolor() ) )
  247.     CenterBox(aMaxLen(aText)+2,Len(aText)+2,Title)
  248.     AEVAL(aText, { | s | CENTER(i++,s) } )
  249.     setcolor(oldColor)
  250. Return (NIL)
  251.  
  252. Function ColorOn
  253. Return ( ISCOLOR() )
  254.  
  255. Function CenterBox(w,h,cStr)
  256.     WideBox(MIDRow()-(h/2),MIDCol()-(w/2),MIDRow()+(h/2),MIDCol()+(w/2),cStr)
  257. Return (NIL)
  258. /* 
  259. * Split a semicolon  or otherwise delimited string into an Array 
  260. */
  261. STATIC function aDelimit(cStr,cDelim)
  262.     local x,a_:= {}
  263.     cDelim    := IF(cDelim=NIL,[;],cDelim)
  264.     WHILE (x  := AT(cDelim,cStr)) <> 0
  265.         AADD(a_, SUBS(cStr,1,x-1))
  266.         cStr  := SUBS(cStr,x+len(cDelim))
  267.     ENDDO
  268.     AADD(a_,SUBS(cStr,x+len(cDelim)))
  269. return (a_)
  270. /* 
  271. * Return Length of largest string in array 
  272. */
  273. STATIC function aMaxLen(a_)
  274.     local MaxLen := 0
  275.     AEVAL(a_, { | s | MaxLen := Max(Len(s),MaxLen) } )
  276. return (MaxLen)
  277. /*
  278. * gotta use a real function and not xtranslate else unresolved 
  279. * extern in code-block. (any other methods?)
  280. */
  281. function Center(nRow, cMsg, cColor )
  282.     cColor := IF(valtype(cColor)=="U",MsgColor,cColor)
  283.     DevPos( nRow, int((maxcol() + 1 - len( cMsg )) / 2))
  284.     DevOut( cMsg, cColor )
  285. return nil
  286.  
  287.  
  288.